# Dickstein, Ho, and Mark (2023)
# This script sets global parameters used throughout the code. 

# Uncomment to send output to both terminal and to "Latest_Output.txt":
# sink("Latest_Output.txt", append=FALSE, split=TRUE) 

# Where is the project folder?
# Change this to your own location in order to replicate. 
project_folder <- "~/sharedWork/oregon/replication_package"

# Set the working directory to the data_folder
setwd(paste0(project_folder, "/data"))

# Load some commonly used libraries and set the base seed to 1991 
# (this is sometimes changed to another seed in specific programs). 
library(dplyr)
library(tidyr)
library(data.table)
try(library(stringdist))
try(library(stringr))
library(ggplot2)
try(library(gtools))
try(library(stargazer))
library(foreign)
set.seed(1991)
options(scipen = 10)

# Defining commonly used objects and functions
Months.Vec <- c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
Shortyear.Vec <- c("10", "11", "12", "13", "14", "15", "16")

is.identified <- function(Data, Vars){
  logical <- (nrow(unique(Data[, Vars, with = FALSE])) == nrow(Data))
  print(paste0("It is ", logical, " that ", paste(Vars, collapse = " & "), " identif(y/ies) the dataset."))
  return(logical)
}

allbut <- function(Data, x) c(names(Data)[!names(Data) %in% x])

allDup <- function (value) 
{ 
duplicated(value) | duplicated(value, fromLast = TRUE) 
}

mode1 <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

mode1na <- function(x, na.rm) {
  ux <- unique(x)
  cl <- class(x)
  if (na.rm == FALSE){
    return(ux[which.max(tabulate(match(x, ux)))])
  } else if (all(is.na(ux))){
    return(ux)
  } else {
    ux <- ux[which(!is.na(ux))]  
    return(ux[which.max(tabulate(match(x, ux)))])
  }
}

mode1countna <- function(x, na.rm) {
  ux <- unique(x)
  cl <- class(x)
  if (na.rm == FALSE){
    return(ux[which.max(tabulate(match(x, ux)))])
  } else if (all(is.na(ux))){
    return(ux)
  } else {
    ux <- ux[which(!is.na(ux))]  
    return(max(tabulate(match(x, ux))))
  }
}

#This function removes one type out of the running before applying mode1narm:
mode1narm <- function(x, na.rm, rm) {
  x.foo <- x[which(x != rm)]
  x.foo <- ifelse(length(x.foo) == 0, c(x.foo, NA),x.foo)
  ux <- unique(x.foo)
  if (na.rm == FALSE){
    return(ux[which.max(tabulate(match(x.foo, ux)))])
  } else if (all(is.na(ux))){
    return(ux)
  } else {
    ux <- ux[which(!is.na(ux))]  
    return(ux[which.max(tabulate(match(x.foo, ux)))])
  }
}

#This function counts the number of unique values associated with each individual: 
Ncount <- function(x, na.rm)
{
  ux <- unique(x)
  cl <- class(x)
  if (na.rm == FALSE){
    return(length(ux))
  } else {
    return(sum(!is.na(ux)))
  }
}

#Removal type: 
Ncountrm <- function(x, na.rm, rm)
{
  x.foo <- x[which(x != rm)]
  ux <- unique(x.foo)
  cl <- class(x.foo)
  if (na.rm == FALSE){
    return(length(ux))
  } else {
    return(sum(!is.na(ux)))
  }
}

oneszeros <- function (x) as.numeric(x != "NA")
#Turns a vector 01,02,03,NA,NA,NA...|...|... into a count of number of non-NA's per person. 
Collect.N <- function(x, delim){
x <- paste(apply(do.call("rbind",lapply(strsplit(as.character(x), delim), oneszeros)), 2, sum), collapse = ",")
x <- ifelse(length(x) == 0, NA, x)
}
#Takes a list of numbers and returns a list of 0 if 0, 1 if non-zero:
Collect.E <- function(x,delim) paste(as.numeric(strsplit(as.character(x), delim)[[1]] != "0"), collapse = ",")
sum.char <- function (x) sum(as.numeric(x), na.rm = TRUE)
Collect.Sum <- function(x, delim) sapply(strsplit(as.character(x), delim), sum.char)
sum.female <- function (x) sum(as.numeric(x == "F"))
Collect.Sum.Fem <- function(x, delim, char) sapply(strsplit(as.character(x), delim), sum.female)
sum.E <- function (x) sum(oneszeros(x))
Collect.Sum.E <- function(x, delim, char) sapply(strsplit(as.character(x), delim), sum.E)

#Tests whether all variables have the same class over time:
TestClassConsistency <- function(listtotest){
barney <- logical(6)
for (i in 1:6){
  barney[i] <- all(sapply(listtotest[[i]],class) == sapply(listtotest[[7]],class))
}
if (all(barney)){
  print("All variables have the same class throughout time")
} else {
  print("Warning: All variables do not have the same class throughout time")
}
rm(barney)
}

#Provides quantiles:
which.quantile <- function (x, probs, na.rm = FALSE){
  if (! na.rm & any (is.na (x)))
    return (rep (NA_integer_, length (probs)))
  
  o <- order (x)
  n <- sum (! is.na (x))
  o <- o [seq_len (n)]
  
  nppm <- n * probs - 0.5
  j <- floor(nppm)
  h <- ifelse((nppm == j) & ((j%%2L) == 0L), 0, 1)
  j <- j + h
  
  j [j == 0] <- 1
  o[j]
}

# Creates a LateX table out of a data.table:
MakeLatexTable <- function(startcodelist, # A list which includes row latex code
                           dataframe, # This dataframe includes rownames and data to be added
                           endcodelist # A list which includes a row of latex code in each element.
){
  
  for(i in seq_along(startcodelist)){
    cat(paste0(startcodelist[[i]], "\n"))
  }
  
  for(i in 1:nrow(dataframe)){
    cat(paste0(row.names(dataframe)[i], " & ", paste(round(unlist(as.matrix(dataframe)[i,]), 3), collapse = " & "), "\\\\\n"))
  }
  
  for(i in seq_along(endcodelist)){
    if(i != length(endcodelist)){
      cat(paste0(endcodelist[[i]], "\n"))
    } else {
      cat(endcodelist[[i]])
    }
  }
  
}
